home *** CD-ROM | disk | FTP | other *** search
/ CU Amiga Super CD-ROM 15 / CU Amiga Magazine's Super CD-ROM 15 (1997)(EMAP Images)(GB)[!][issue 1997-10].iso / CUCD / Graphics / Ghostscript / source / zcontrol.c < prev    next >
C/C++ Source or Header  |  1997-05-05  |  20KB  |  764 lines
  1. /* Copyright (C) 1989, 1996, 1997 Aladdin Enterprises.  All rights reserved.
  2.   
  3.   This file is part of Aladdin Ghostscript.
  4.   
  5.   Aladdin Ghostscript is distributed with NO WARRANTY OF ANY KIND.  No author
  6.   or distributor accepts any responsibility for the consequences of using it,
  7.   or for whether it serves any particular purpose or works at all, unless he
  8.   or she says so in writing.  Refer to the Aladdin Ghostscript Free Public
  9.   License (the "License") for full details.
  10.   
  11.   Every copy of Aladdin Ghostscript must include a copy of the License,
  12.   normally in a plain ASCII text file named PUBLIC.  The License grants you
  13.   the right to copy, modify and redistribute Aladdin Ghostscript, but only
  14.   under certain conditions described in the License.  Among other things, the
  15.   License requires that the copyright notice and this notice be preserved on
  16.   all copies.
  17. */
  18.  
  19. /* zcontrol.c */
  20. /* Control operators */
  21. #include "string_.h"
  22. #include "ghost.h"
  23. #include "stream.h"
  24. #include "errors.h"
  25. #include "oper.h"
  26. #include "estack.h"
  27. #include "files.h"
  28. #include "ipacked.h"
  29. #include "iutil.h"
  30. #include "store.h"
  31.  
  32. /* Make an invalid file object. */
  33. extern void make_invalid_file(P1(ref *)); /* in zfile.c */
  34.  
  35. /* Forward references */
  36. private int no_cleanup(P1(os_ptr));
  37. private uint count_to_stopped(P1(long));
  38.  
  39. /* See the comment in opdef.h for an invariant which allows */
  40. /* more efficient implementation of for, loop, and repeat. */
  41.  
  42. /* <[test0 body0 ...]> .cond - */
  43. private int cond_continue(P1(os_ptr));
  44. private int
  45. zcond(register os_ptr op)
  46. {    es_ptr ep = esp;
  47.     /* Push the array on the e-stack and call the continuation. */
  48.     if ( !r_is_array(op) )
  49.       return_op_typecheck(op);
  50.     check_execute(*op);
  51.     if ( (r_size(op) & 1) != 0)
  52.       return_error(e_rangecheck);
  53.     if ( r_size(op) == 0 )
  54.       return zpop(op);
  55.     check_estack(3);
  56.     esp = ep += 3;
  57.     ref_assign(ep - 2, op);    /* the cond body */
  58.     make_op_estack(ep - 1, cond_continue);
  59.     array_get(op, 0L, ep);
  60.     esfile_check_cache();
  61.     pop(1);
  62.     return o_push_estack;
  63. }
  64. private int
  65. cond_continue(register os_ptr op)
  66. {    es_ptr ep = esp;
  67.     int code;
  68.     /* The top element of the e-stack is the remaining tail of */
  69.     /* the cond body.  The top element of the o-stack should be */
  70.     /* the (boolean) result of the test that is the first element */
  71.     /* of the tail. */
  72.     check_type(*op, t_boolean);
  73.     if ( op->value.boolval )
  74.       {                /* true */
  75.         array_get(ep, 1L, ep);
  76.         esfile_check_cache();
  77.         code = o_pop_estack;
  78.       }
  79.     else if ( r_size(ep) > 2 )
  80.       {                /* false */
  81.         const ref_packed *elts = ep->value.packed;
  82.         check_estack(2);
  83.         r_dec_size(ep, 2);
  84.         elts = packed_next(elts);
  85.         elts = packed_next(elts);
  86.         ep->value.packed = elts;
  87.         array_get(ep, 0L, ep + 2);
  88.         make_op_estack(ep + 1, cond_continue);
  89.         esp = ep + 2;
  90.         esfile_check_cache();
  91.         code = o_push_estack;
  92.       }
  93.     else
  94.       {                /* fall off end of cond */
  95.         esp = ep - 1;
  96.         code = o_pop_estack;
  97.       }
  98.     pop(1);            /* get rid of the boolean */
  99.     return code;
  100. }
  101.  
  102. /* <obj> exec - */
  103. int
  104. zexec(register os_ptr op)
  105. {    check_op(1);
  106.     if ( !r_has_attr(op, a_executable) )
  107.       return 0;        /* literal object just gets pushed back */
  108.     check_estack(1);
  109.     ++esp;
  110.     ref_assign(esp, op);
  111.     esfile_check_cache();
  112.     pop(1);
  113.     return o_push_estack;
  114. }
  115.  
  116. /* <obj1> ... <objn> <n> .execn - */
  117. int
  118. zexecn(register os_ptr op)
  119. {    uint n, i;
  120.     es_ptr esp_orig;
  121.  
  122.     check_int_leu(*op, max_uint - 1);
  123.     n = (uint)op->value.intval;
  124.     check_op(n + 1);
  125.     check_estack(n);
  126.     esp_orig = esp;
  127.     for ( i = 0; i < n; ++i )
  128.       { const ref *rp = ref_stack_index(&o_stack, (long)(i + 1));
  129.  
  130.         /* Make sure this object is legal to execute. */
  131.         switch ( r_type(rp) )
  132.           {
  133.           case_types_with_access:
  134.         if ( !r_has_attr(rp, a_execute) &&
  135.              r_has_attr(rp, a_executable)
  136.            )
  137.           { esp = esp_orig;
  138.             return_error(e_invalidaccess);
  139.           }
  140.           default:
  141.         DO_NOTHING;
  142.           }
  143.         /* Executable nulls have a special meaning on the e-stack, */
  144.         /* so since they are no-ops, don't push them. */
  145.         if ( !r_has_type_attrs(rp, t_null, a_executable) )
  146.           { ++esp;
  147.             ref_assign(esp, rp);
  148.           }
  149.       }
  150.     esfile_check_cache();
  151.     pop(n + 1);
  152.     return o_push_estack;
  153. }
  154.  
  155. /* <obj> superexec - */
  156. /* THIS IS NOT REALLY IMPLEMENTED YET. */
  157. private int
  158. zsuperexec(os_ptr op)
  159. {    return zexec(op);
  160. }
  161.  
  162. /* <bool> <proc> if - */
  163. int
  164. zif(register os_ptr op)
  165. {    check_type(op[-1], t_boolean);
  166.     check_proc(*op);
  167.     if ( op[-1].value.boolval )
  168.        {    check_estack(1);
  169.         ++esp;
  170.         ref_assign(esp, op);
  171.         esfile_check_cache();
  172.        }
  173.     pop(2);
  174.     return o_push_estack;
  175. }
  176.  
  177. /* <bool> <proc_true> <proc_false> ifelse - */
  178. int
  179. zifelse(register os_ptr op)
  180. {    check_type(op[-2], t_boolean);
  181.     check_proc(op[-1]);
  182.     check_proc(*op);
  183.     check_estack(1);
  184.     ++esp;
  185.     if ( op[-2].value.boolval )
  186.        {    ref_assign(esp, op - 1);
  187.        }
  188.     else
  189.        {    ref_assign(esp, op);
  190.        }
  191.     esfile_check_cache();
  192.     pop(3);
  193.     return o_push_estack;
  194. }
  195.  
  196. /* <init> <step> <limit> <proc> for - */
  197. private int
  198.   for_pos_int_continue(P1(os_ptr)),
  199.   for_neg_int_continue(P1(os_ptr)),
  200.   for_real_continue(P1(os_ptr));
  201. int
  202. zfor(register os_ptr op)
  203. {    register es_ptr ep;
  204.     check_estack(7);
  205.     ep = esp + 6;
  206.     check_proc(*op);
  207.     /* Push a mark, the control variable, the initial value, */
  208.     /* the increment, the limit, and the procedure, */
  209.     /* and invoke the continuation operator. */
  210.     if ( r_has_type(op - 3, t_integer) &&
  211.          r_has_type(op - 2, t_integer)
  212.        )
  213.       {    make_int(ep - 4, op[-3].value.intval);
  214.         make_int(ep - 3, op[-2].value.intval);
  215.         switch ( r_type(op - 1) )
  216.           {
  217.           case t_integer:
  218.             make_int(ep - 2, op[-1].value.intval);
  219.             break;
  220.           case t_real:
  221.             make_int(ep - 2, (long)op[-1].value.realval);
  222.             break;
  223.           default:
  224.             return_op_typecheck(op - 1);
  225.           }
  226.         if ( ep[-3].value.intval >= 0 )
  227.           make_op_estack(ep, for_pos_int_continue);
  228.         else
  229.           make_op_estack(ep, for_neg_int_continue);
  230.       }
  231.     else
  232.       {    float params[3];
  233.         int code;
  234.         if ( (code = num_params(op - 1, 3, params)) < 0 )
  235.           return code;
  236.         make_real(ep - 4, params[0]);
  237.         make_real(ep - 3, params[1]);
  238.         make_real(ep - 2, params[2]);
  239.         make_op_estack(ep, for_real_continue);
  240.       }
  241.     make_mark_estack(ep - 5, es_for, no_cleanup);
  242.     ref_assign(ep - 1, op);
  243.     esp = ep;
  244.     pop(4);
  245.     return o_push_estack;
  246. }
  247. /* Continuation operators for for, separate for positive integer, */
  248. /* negative integer, and real. */
  249. /* Execution stack contains mark, control variable, increment, */
  250. /* limit, and procedure (procedure is topmost.) */
  251. /* Continuation operator for positive integers. */
  252. private int
  253. for_pos_int_continue(register os_ptr op)
  254. {    register es_ptr ep = esp;
  255.     long var = ep[-3].value.intval;
  256.     if ( var > ep[-1].value.intval )
  257.        {    esp -= 5;    /* pop everything */
  258.         return o_pop_estack;
  259.        }
  260.     push(1);
  261.     make_int(op, var);
  262.     ep[-3].value.intval = var + ep[-2].value.intval;
  263.     ref_assign_inline(ep + 2, ep);        /* saved proc */
  264.     esp = ep + 2;
  265.     return o_push_estack;
  266. }
  267. /* Continuation operator for negative integers. */
  268. private int
  269. for_neg_int_continue(register os_ptr op)
  270. {    register es_ptr ep = esp;
  271.     long var = ep[-3].value.intval;
  272.     if ( var < ep[-1].value.intval )
  273.        {    esp -= 5;    /* pop everything */
  274.         return o_pop_estack;
  275.        }
  276.     push(1);
  277.     make_int(op, var);
  278.     ep[-3].value.intval = var + ep[-2].value.intval;
  279.     ref_assign(ep + 2, ep);        /* saved proc */
  280.     esp = ep + 2;
  281.     return o_push_estack;
  282. }
  283. /* Continuation operator for reals. */
  284. private int
  285. for_real_continue(register os_ptr op)
  286. {    es_ptr ep = esp;
  287.     float var = ep[-3].value.realval;
  288.     float incr = ep[-2].value.realval;
  289.     if ( incr >= 0 ? (var > ep[-1].value.realval) :
  290.         (var < ep[-1].value.realval)
  291.        )
  292.       {    esp -= 5;    /* pop everything */
  293.         return o_pop_estack;
  294.       }
  295.     push(1);
  296.     ref_assign(op, ep - 3);
  297.     ep[-3].value.realval = var + incr;
  298.     esp = ep + 2;
  299.     ref_assign(ep + 2, ep);        /* saved proc */
  300.     return o_push_estack;
  301. }
  302.  
  303. /* Here we provide an internal variant of 'for' that enumerates the */
  304. /* values 0, 1/N, 2/N, ..., 1 precisely.  The arguments must be */
  305. /* the integers 0, 1, and N.  We need this for */
  306. /* loading caches such as the transfer function cache. */
  307. private int for_fraction_continue(P1(os_ptr));
  308. int
  309. zfor_fraction(register os_ptr op)
  310. {    int code = zfor(op);
  311.     if ( code < 0 ) return code;    /* shouldn't ever happen! */
  312.     make_op_estack(esp, for_fraction_continue);
  313.     return code;
  314. }
  315. /* Continuation procedure */
  316. private int
  317. for_fraction_continue(register os_ptr op)
  318. {    register es_ptr ep = esp;
  319.     int code = for_pos_int_continue(op);
  320.     if ( code != o_push_estack )
  321.       return code;
  322.     /* We must use osp instead of op here, because */
  323.     /* for_pos_int_continue pushes a value on the o-stack. */
  324.     make_real(osp, (float)osp->value.intval / ep[-1].value.intval);
  325.     return code;
  326. }
  327.  
  328. /* <int> <proc> repeat - */
  329. private int repeat_continue(P1(os_ptr));
  330. private int
  331. zrepeat(register os_ptr op)
  332. {    check_type(op[-1], t_integer);
  333.     check_proc(*op);
  334.     if ( op[-1].value.intval < 0 )
  335.         return_error(e_rangecheck);
  336.     check_estack(5);
  337.     /* Push a mark, the count, and the procedure, and invoke */
  338.     /* the continuation operator. */
  339.     push_mark_estack(es_for, no_cleanup);
  340.     *++esp = op[-1];
  341.     *++esp = *op;
  342.     make_op_estack(esp + 1, repeat_continue);
  343.     pop(2);
  344.     return repeat_continue(op - 2);
  345. }
  346. /* Continuation operator for repeat */
  347. private int
  348. repeat_continue(register os_ptr op)
  349. {    es_ptr ep = esp;        /* saved proc */
  350.     if ( --(ep[-1].value.intval) >= 0 )    /* continue */
  351.        {    esp += 2;
  352.         ref_assign(esp, ep);
  353.         return o_push_estack;
  354.        }
  355.     else                /* done */
  356.        {    esp -= 3;        /* pop mark, count, proc */
  357.         return o_pop_estack;
  358.        }
  359. }
  360.  
  361. /* <proc> loop */
  362. private int loop_continue(P1(os_ptr));
  363. private int
  364. zloop(register os_ptr op)
  365. {    check_proc(*op);
  366.     check_estack(4);
  367.     /* Push a mark and the procedure, and invoke */
  368.     /* the continuation operator. */
  369.     push_mark_estack(es_for, no_cleanup);
  370.     *++esp = *op;
  371.     make_op_estack(esp + 1, loop_continue);
  372.     pop(1);
  373.     return loop_continue(op - 1);
  374. }
  375. /* Continuation operator for loop */
  376. private int
  377. loop_continue(register os_ptr op)
  378. {    register es_ptr ep = esp;        /* saved proc */
  379.     ref_assign(ep + 2, ep);
  380.     esp = ep + 2;
  381.     return o_push_estack;
  382. }
  383.  
  384. /* - exit - */
  385. private int
  386. zexit(register os_ptr op)
  387. {    uint scanned = 0;
  388.     STACK_LOOP_BEGIN(&e_stack, ep, used)
  389.     {    uint count = used;
  390.         ep += used - 1;
  391.         for ( ; count; count--, ep-- )
  392.           if ( r_is_estack_mark(ep) )
  393.             switch ( estack_mark_index(ep) )
  394.             {
  395.             case es_for:
  396.                 pop_estack(scanned + (used - count + 1));
  397.                 return o_pop_estack;
  398.             case es_stopped:
  399.                 return_error(e_invalidexit);    /* not a loop */
  400.             }
  401.         scanned += used;
  402.     }
  403.     STACK_LOOP_END(ep, used)
  404.     /* Return e_invalidexit if there is no mark at all. */
  405.     /* This is different from PostScript, which aborts. */
  406.     /* It shouldn't matter in practice. */
  407.     return_error(e_invalidexit);
  408. }
  409.  
  410. /*
  411.  * .stopped pushes the following on the e-stack:
  412.  *    - A mark with type = es_stopped and procedure = no_cleanup.
  413.  *    - The result to be pushed on a normal return.
  414.  *    - The signal mask for .stop.
  415.  *    - The procedure %stopped_push, to handle the normal return case.
  416.  */
  417.  
  418. /* In the normal (no-error) case, pop the mask from the e-stack, */
  419. /* and move the result to the o-stack. */
  420. private int
  421. stopped_push(register os_ptr op)
  422. {    push(1);
  423.     *op = esp[-1];
  424.     esp -= 3;
  425.     return o_pop_estack;
  426. }
  427.  
  428. /* - stop - */
  429. /* Equivalent to true 1 .stop. */
  430. /* This is implemented in C because if were a pseudo-operator, */
  431. /* the stacks would get restored in case of an error. */
  432. private int
  433. zstop(register os_ptr op)
  434. {    uint count = count_to_stopped(1L);
  435.  
  436.     if ( count )
  437.       { /*
  438.          * If there are any t_oparrays on the e-stack, they will pop
  439.          * any new items from the o-stack.  Wait to push the 'true'
  440.          * until we have run all the unwind procedures.
  441.          */
  442.         check_ostack(2);
  443.         pop_estack(count);
  444.         op = osp;
  445.         push(1);
  446.         make_true(op);
  447.         return o_pop_estack;
  448.       }
  449.     /* Return e_invalidexit if there is no mark at all. */
  450.     /* This is different from PostScript, which aborts. */
  451.     /* It shouldn't matter in practice. */
  452.     return_error(e_invalidexit);
  453. }
  454.  
  455. /* <result> <mask> .stop - */
  456. private int
  457. zzstop(register os_ptr op)
  458. {    uint count;
  459.  
  460.     check_type(*op, t_integer);
  461.     count = count_to_stopped(op->value.intval);
  462.     if ( count )
  463.       { /*
  464.          * If there are any t_oparrays on the e-stack, they will pop
  465.          * any new items from the o-stack.  Wait to push the result
  466.          * until we have run all the unwind procedures.
  467.          */
  468.         ref save_result;
  469.  
  470.         check_op(2);
  471.         save_result = op[-1];
  472.         pop(2);
  473.         pop_estack(count);
  474.         op = osp;
  475.         push(1);
  476.         *op = save_result;
  477.         return o_pop_estack;
  478.       }
  479.     /* Return e_invalidexit if there is no mark at all. */
  480.     /* This is different from PostScript, which aborts. */
  481.     /* It shouldn't matter in practice. */
  482.     return_error(e_invalidexit);
  483. }
  484.  
  485. /* <obj> stopped <stopped> */
  486. /* Equivalent to false 1 .stopped. */
  487. /* This is implemented in C because if were a pseudo-operator, */
  488. /* the stacks would get restored in case of an error. */
  489. private int
  490. zstopped(register os_ptr op)
  491. {    check_op(1);
  492.     /* Mark the execution stack, and push the default result */
  493.     /* in case control returns normally. */
  494.     check_estack(5);
  495.     push_mark_estack(es_stopped, no_cleanup);
  496.     ++esp;
  497.     make_false(esp);        /* save the result */
  498.     ++esp;
  499.     make_int(esp, 1);        /* save the signal mask */
  500.     push_op_estack(stopped_push);
  501.     *++esp = *op;            /* execute the operand */
  502.     esfile_check_cache();
  503.     pop(1);
  504.     return o_push_estack;
  505. }
  506.  
  507. /* <obj> <result> <mask> .stopped <result> */
  508. private int
  509. zzstopped(register os_ptr op)
  510. {    check_type(*op, t_integer);
  511.     check_op(3);
  512.     /* Mark the execution stack, and push the default result */
  513.     /* in case control returns normally. */
  514.     check_estack(5);
  515.     push_mark_estack(es_stopped, no_cleanup);
  516.     *++esp = op[-1];        /* save the result */
  517.     *++esp = *op;            /* save the signal mask */
  518.     push_op_estack(stopped_push);
  519.     *++esp = op[-2];        /* execute the operand */
  520.     esfile_check_cache();
  521.     pop(3);
  522.     return o_push_estack;
  523. }
  524.  
  525. /* <mask> .instopped false */
  526. /* <mask> .instopped <result> true */
  527. private int
  528. zinstopped(register os_ptr op)
  529. {    uint count;
  530.  
  531.     check_type(*op, t_integer);
  532.     count = count_to_stopped(op->value.intval);
  533.     if ( count )
  534.       { push(1);
  535.         op[-1] = *ref_stack_index(&e_stack, count - 2);    /* default result */
  536.         make_true(op);
  537.       }
  538.     else
  539.       make_false(op);
  540.     return 0;
  541. }
  542.  
  543. /* - countexecstack <int> */
  544. private int
  545. zcountexecstack(register os_ptr op)
  546. {    push(1);
  547.     make_int(op, ref_stack_count(&e_stack));
  548.     return 0;
  549. }
  550.  
  551. /* <array> execstack <subarray> */
  552. private int execstack_continue(P1(os_ptr));
  553. private int
  554. zexecstack(register os_ptr op)
  555. {    /*
  556.      * We can't do this directly, because the interpreter
  557.      * might have cached some state.  To force the interpreter
  558.      * to update the stored state, we push a continuation on
  559.      * the exec stack; the continuation is executed immediately,
  560.      * and does the actual transfer.
  561.      */
  562.     uint depth = ref_stack_count(&e_stack);
  563.  
  564.     check_write_type(*op, t_array);
  565.     if ( depth > r_size(op) )
  566.       return_error(e_rangecheck);
  567.     check_estack(1);
  568.     r_set_size(op, (uint)depth);
  569.     push_op_estack(execstack_continue);
  570.     return o_push_estack;
  571. }
  572. /* Continuation operator to do the actual transfer. */
  573. /* r_size(op) was set just above. */
  574. private int
  575. execstack_continue(register os_ptr op)
  576. {    int code =
  577.       ref_stack_store(&e_stack, op, r_size(op), 0, 0, true, "execstack");
  578.     uint asize = r_size(op);
  579.     uint i;
  580.     ref *rp;
  581.  
  582.     if ( code < 0 )
  583.       return code;
  584.     /*
  585.      * Clear the executable bit in any internal operators, and
  586.      * convert t_structs and t_astructs (which can only appear
  587.      * in connection with stack marks, which means that they will
  588.      * probably be freed when unwinding) to something harmless.
  589.      */
  590.     for ( i = 0, rp = op->value.refs; i < asize; i++, rp++ )
  591.       switch ( r_type(rp) )
  592.         {
  593.         case t_operator:
  594.           {    uint opidx = op_index(rp);
  595.         if ( opidx == 0 || op_def_is_internal(op_def_table[opidx]) )
  596.           r_clear_attrs(rp, a_executable);
  597.         break;
  598.           }
  599.         case t_struct:
  600.         case t_astruct:
  601.           {    const char *tname =
  602.           gs_struct_type_name_string(gs_object_type(imemory,
  603.                               rp->value.pstruct));
  604.         make_const_string(rp, a_readonly | avm_foreign,
  605.                   strlen(tname), (const byte *)tname);
  606.         break;
  607.           }
  608.         }
  609.     return 0;
  610. }
  611.  
  612. /* - .needinput - */
  613. private int
  614. zneedinput(register os_ptr op)
  615. {    return e_NeedInput;    /* interpreter will exit to caller */
  616. }
  617.  
  618. /* <obj> <int> .quit - */
  619. private int
  620. zquit(register os_ptr op)
  621. {    check_op(2);
  622.     check_type(*op, t_integer);
  623.     return e_Quit;        /* Interpreter will do the exit */
  624. }
  625.  
  626. /* - currentfile <file> */
  627. private ref *zget_current_file(P0());
  628. private int
  629. zcurrentfile(register os_ptr op)
  630. {    ref *fp;
  631.     push(1);
  632.     /* Check the cache first */
  633.     if ( esfile != 0 )
  634.     {
  635. #ifdef DEBUG
  636.         /* Check that esfile is valid. */
  637.         ref *efp = zget_current_file();
  638.         if ( esfile != efp )
  639.           { lprintf2("currentfile: esfile=0x%lx, efp=0x%lx\n",
  640.                  (ulong)esfile, (ulong)efp);
  641.             ref_assign(op, efp);
  642.           }
  643.         else
  644. #endif
  645.         ref_assign(op, esfile);
  646.     }
  647.     else if ( (fp = zget_current_file()) == 0 )
  648.     {    /* Return an invalid file object. */
  649.         /* This doesn't make a lot of sense to me, */
  650.         /* but it's what the PostScript manual specifies. */
  651.         make_invalid_file(op);
  652.     }
  653.     else
  654.     {    ref_assign(op, fp);
  655.         esfile_set_cache(fp);
  656.     }
  657.     /* Make the returned value literal. */
  658.     r_clear_attrs(op, a_executable);
  659.     return 0;
  660. }
  661. /* Get the current file from which the interpreter is reading. */
  662. private ref *
  663. zget_current_file(void)
  664. {    STACK_LOOP_BEGIN(&e_stack, ep, used)
  665.     {    uint count = used;
  666.         ep += used - 1;
  667.         for ( ; count; count--, ep-- )
  668.           if ( r_has_type_attrs(ep, t_file, a_executable) )
  669.             return ep;
  670.     }
  671.     STACK_LOOP_END(ep, used)
  672.     return 0;
  673. }
  674.  
  675. /* ------ Initialization procedure ------ */
  676.  
  677. BEGIN_OP_DEFS(zcontrol_op_defs) {
  678.     {"1.cond", zcond},
  679.     {"0countexecstack", zcountexecstack},
  680.     {"0currentfile", zcurrentfile},
  681.     {"1exec", zexec},
  682.     {"1.execn", zexecn},
  683.     {"0execstack", zexecstack},
  684.     {"0exit", zexit},
  685.     {"2if", zif},
  686.     {"3ifelse", zifelse},
  687.     {"0.instopped", zinstopped},
  688.     {"0.needinput", zneedinput},
  689.     {"4for", zfor},
  690.     {"1loop", zloop},
  691.     {"2.quit", zquit},
  692.     {"2repeat", zrepeat},
  693.     {"0stop", zstop},
  694.     {"1.stop", zzstop},
  695.     {"1stopped", zstopped},
  696.     {"2.stopped", zzstopped},
  697.         /* Internal operators */
  698.     {"1%cond_continue", cond_continue},
  699.     {"0%execstack_continue", execstack_continue},
  700.     {"0%for_pos_int_continue", for_pos_int_continue},
  701.     {"0%for_neg_int_continue", for_neg_int_continue},
  702.     {"0%for_real_continue", for_real_continue},
  703.     {"4%for_fraction", zfor_fraction},
  704.     {"0%for_fraction_continue", for_fraction_continue},
  705.     {"0%loop_continue", loop_continue},
  706.     {"0%repeat_continue", repeat_continue},
  707.     {"0%stopped_push", stopped_push},
  708.         /* Operators defined in internaldict */
  709.         op_def_begin_dict("internaldict"),
  710.     {"1superexec", zsuperexec},
  711. END_OP_DEFS(0) }
  712.  
  713. /* ------ Internal routines ------ */
  714.  
  715. /* Vacuous cleanup routine */
  716. private int
  717. no_cleanup(os_ptr op)
  718. {    return 0;
  719. }
  720.  
  721. /*
  722.  * Count the number of elements down to and including the first 'stopped'
  723.  * mark on the e-stack with a given mask.  Return 0 if there is no 'stopped'
  724.  * mark.
  725.  */
  726. private uint
  727. count_to_stopped(long mask)
  728. {    uint scanned = 0;
  729.     STACK_LOOP_BEGIN(&e_stack, ep, used)
  730.     {    uint count = used;
  731.         ep += used - 1;
  732.         for ( ; count; count--, ep-- )
  733.           if ( r_is_estack_mark(ep) &&
  734.                estack_mark_index(ep) == es_stopped &&
  735.                (ep[2].value.intval & mask) != 0
  736.              )
  737.             return scanned + (used - count + 1);
  738.         scanned += used;
  739.     }
  740.     STACK_LOOP_END(ep, used)
  741.     return 0;
  742. }
  743.  
  744. /* Pop the e-stack, executing cleanup procedures as needed. */
  745. /* We could make this more efficient using the STACK_LOOP macros, */
  746. /* but it isn't used enough to make this worthwhile. */
  747. void
  748. pop_estack(uint count)
  749. {    uint idx = 0;
  750.     uint popped = 0;
  751.  
  752.     esfile_clear_cache();
  753.     for ( ; idx < count; idx++ )
  754.       { ref *ep = ref_stack_index(&e_stack, idx - popped);
  755.  
  756.         if ( r_is_estack_mark(ep) )
  757.           { ref_stack_pop(&e_stack, idx + 1 - popped);
  758.             popped = idx + 1;
  759.         (*real_opproc(ep))(osp);
  760.           }
  761.       }
  762.     ref_stack_pop(&e_stack, count - popped);
  763. }
  764.